perm filename TRAJCT.SAI[1,BGB] blob
sn#001267 filedate 1972-10-22 generic text, type T, neo UTF8
00100 BEGIN "TRAJCT"
00200 DEFINE α = "COMMENT";
00300 α DISPLAY DECLARATION;
00400 INTEGER ARRAY DPYBUF [1:500];
00500 REQUIRE "DISPLY[SYS,BGB]" LOAD_MODULE;
00600 EXTERNAL PROCEDURE DPYSET (INTEGER ARRAY DPYBUF);
00700 EXTERNAL PROCEDURE AIVECT (INTEGER X,Y);
00800 EXTERNAL PROCEDURE AVECT (INTEGER X,Y);
00900 EXTERNAL PROCEDURE DPYOUT (INTEGER POG);
01000 EXTERNAL PROCEDURE DPYSST (STRING S);
01100 α TRIG DECLARATIONS;
01200 DEFINE π = "3.1415927";
01300 REQUIRE "SAITRG[SYS,BGB]" LOAD_MODULE;
01400 EXTERNAL REAL PROCEDURE SIN (REAL X);
01500 EXTERNAL REAL PROCEDURE COS (REAL X);
01600 EXTERNAL REAL PROCEDURE ACOS (REAL X);
01700 EXTERNAL REAL PROCEDURE SQRT (REAL X);
01800 α NUMBER OF POINTS HORIZONTAL & VERTICAL, OF ARCSEGS, OF VECTORS 3D OUT;
01900 INTEGER N1,N2,N3,N4;
00100 REAL PROCEDURE DETERM (REAL ARRAY A);
00200 BEGIN
00300 REAL Z1,Z2,Z3,Z4;
00400 REAL A11,A12,A13,A14,A21,A22,A23,A24,A31,A32,A33,A34,A41,A42,A43,A44;
00500 DEFINE DET3BY3 (A11,A12,A13,A21,A22,A23,A31,A32,A33)
00600 = "(A11*(A22*A33-A23*A32)
00700 - A12*(A21*A33-A23*A31)
00800 + A13*(A21*A32-A22*A31))";
00900 ARRBLT(A11,A[1,1],16);
01000 Z1 ← +A11*DET3BY3(A22,A23,A24,A32,A33,A34,A42,A43,A44);
01100 Z2 ← -A12*DET3BY3(A21,A23,A24,A31,A33,A34,A41,A43,A44);
01200 Z3 ← +A13*DET3BY3(A21,A22,A24,A31,A32,A34,A41,A42,A44);
01300 Z4 ← -A14*DET3BY3(A21,A22,A23,A31,A32,A33,A41,A42,A43);
01400 RETURN (Z1+Z2+Z3+Z4);
01500 END;
00100 α COMPUTE SPLINE COEFFICIENTS OF Z-ELEVATION BETWEEN GRADES;
00200 BOOLEAN FLGZ;
00300 REAL ARRAY COEF [1:4];
00400 PROCEDURE SPLINE (REAL L1,Z1,L2,Z2,L3,Z3);
00500 BEGIN "SPLINE"
00600 REAL ARRAY X[1:4],A[1:4,1:4];
00700 INTEGER I,J; REAL E;
00800
00900 A[1,1]←L1↑3; A[1,2]←L1↑2; A[1,3]←L1; A[1,4]←1;
01000 A[2,1]←L3↑3; A[2,2]←L3↑2; A[2,3]←L3; A[2,4]←1;
01100 A[3,1]←3*L1↑2; A[3,2]←2*L1; A[3,3]←1; A[3,4]←0;
01200 A[4,1]←3*L3↑2; A[4,2]←2*L3; A[4,3]←1; A[4,4]←0;
01300
01400 E ← DETERM (A);
01500 X[1] ← Z1;
01600 X[2] ← Z3;
01700 X[3] ← (Z2-Z1) / (L2-L1);
01800 X[4] ← (Z3-Z2) / (L3-L2);
01900
02000 FOR I←1 STEP 1 UNTIL 4 DO
02100 BEGIN
02200 FOR J←1 STEP 1 UNTIL 4 DO A[J,I] ↔ X[J];
02300 COEF[I] ← DETERM (A) /E;
02400 FOR J←1 STEP 1 UNTIL 4 DO A[J,I] ↔ X[J];
02500 END;
02600 FLGZ ← FALSE;
02700 END "SPLINE";
02800
02900 α COMPUTE LINEAR COEFFICIENT FOR A GRADE;
03000 REAL DZ;
03100 PROCEDURE GRADE (REAL L0,Z0,L1,Z1);
03200 BEGIN
03300 FLGZ ← TRUE;
03400 DZ ← (Z1-Z0) / (L1-L0);
03500 END;
00100 α .MAP FILE OPENING CEREMONIES;
00200 BEGIN "OPENINGS"
00300 LABEL L1,L2;
00400 INTEGER FLG;
00500 STRING FILNAM;
00600 OPEN(1,"DSK",8,3,0,0,0,0);
00700 L1: OUTSTR(".MAP FILE = ");
00800 FILNAM ← INCHWL;
00900 LOOKUP(1,FILNAM&".MAP",FLG);
01000 IF FLG THEN GO L1;
01100 OPEN(2,"DSK",8,1,1,0,0,0);
01200 L2: OUTSTR(".V3D FILE = ");
01300 FILNAM ← INCHWL;
01400 ENTER(2,FILNAM&".V3D",FLG);
01500 LOOKUP(2,FILNAM&".V3D",FLG);
01600 IF FLG THEN GO L2;
01700 WORDOUT(2,0);
01800 END "OPENINGS";
01900 α READ MAP HEADER;
02000 N1 ← WORDIN(1);
02100 N2 ← WORDIN(1);
02200 N3 ← WORDIN(1);
02300 α THE 511 SQUARE;
02400 DPYSET(DPYBUF);
02500 AIVECT(-511,-511);
02600 AVECT( 511,-511);
02700 AVECT( 511, 511);
02800 AVECT(-511, 511);
02900 AVECT(-511,-511);
03000 DPYOUT(0);
00100 BEGIN "DATA BLK"
00200 REAL DISPLACEXY,DISPLACEZ,DU,DV,DL;
00300 REAL U,X,Y,Z,X1,Y1,X2,Y2,X3,Y3,DPYX,DPYY,SEGLENGTH,ARCLENGTH;
00400 REAL DX,DY,VX,VY,R;
00500 INTEGER P1,P2,P3,I,J,N,ARCSEGPTR,PLZPTR,POG;
00600 LABEL L;
00700 α LINE SEGMENT DISPLAY;
00800 PROCEDURE DPYSEG; IF 15 < SQRT((DPYX-X)↑2+(DPYY-Y)↑2) THEN
00900 AVECT (1.5*(DPYX←X),1.5*(DPYY←Y));
01000 α MAP ARRAYS;
01100 REAL ARRAY PXY[1:N1,1:2],PLZ[1:N2,1:2];
01200 INTEGER ARRAY ARCSEG[0:N3];
00100 α COMPUTE Z-ELEVATION AS A FUNCTION
00200 OF THE PARAMETRIC VARIABLE U, LENGTH DOWN THE ROAD;
00300 PROCEDURE ZELEV;
00400 BEGIN "ZELEV"
00500
00600 DEFINE A = "COEF[1]";
00700 DEFINE B = "COEF[2]";
00800 DEFINE C = "COEF[3]";
00900 DEFINE D = "COEF[4]";
01000
01100 DEFINE L0 = "PLZ[PLZPTR ,1]", Z0 = "PLZ[PLZPTR ,2]";
01200 DEFINE L1 = "PLZ[PLZPTR+1,1]", Z1 = "PLZ[PLZPTR+1,2]";
01300 DEFINE L2 = "PLZ[PLZPTR+2,1]", Z2 = "PLZ[PLZPTR+2,2]";
01400 DEFINE L3 = "PLZ[PLZPTR+3,1]", Z3 = "PLZ[PLZPTR+3,2]";
01500
01600 α FIRST TEST FOR END OF GRADE OR END OF SPLINE;
01700 IF FLGZ THEN
01800 IF U>L1 THEN SPLINE(L1,Z1,L2,Z2,L3,Z3) ELSE
01900 ELSE
02000 IF U>L3 THEN BEGIN PLZPTR ← PLZPTR+3;GRADE(L0,Z0,L1,Z1);END;
02100
02200 α SECOND COMPUTE THE Z-ELEVATION ON THE CURRENT GRADE OR SPLINE;
02300 IF FLGZ THEN Z ← Z0 + (U-L0)*DZ
02400 ELSE Z ← ((A*U + B)*U + C)*U + D;
02500 Z ← Z + DISPLACEZ;
02600
02700 END "ZELEV";
00100 α READ THE MAP INTO CORE;
00200 ARRYIN(1,PXY[1,1],2*N1);
00300 ARRYIN(1,PLZ[1,1],2*N2);
00400 ARRYIN(1,ARCSEG[0], N3+1);
00500 RELEASE(1);
00600 L: Z ← U ← 0;
00700 α GET ARGUMENTS FROM THE USER;
00800 BEGIN "GETARG"
00900 STRING STR;
01000 INTEGER CHR;
01100
01200 OUTSTR ("HORIZONTAL DISPLACEMENT = ");
01300 STR ← INCHWL;
01400 DISPLACEXY ← REALSCAN(STR,CHR);
01500 IF CHR="""" THEN DISPLACEXY←DISPLACEXY/12;
01600
01700 OUTSTR ("VERTICAL DISPLACEMENT = ");
01800 STR ← INCHWL;
01900 DISPLACEZ ← REALSCAN(STR,CHR);
02000 IF CHR="""" THEN DISPLACEZ←DISPLACEZ/12;
02100
02200 OUTSTR (" LENGTH QUANTUM = ");
02300 STR ← INCHWL;
02400 DU ← REALSCAN(STR,CHR);
02500
02600 OUTSTR (" ARC QUANTUM = ");
02700 STR ← INCHWL;
02800 DV ← REALSCAN(STR,CHR)*π/180;
02900 END "GETARG";
00100 α INITIALIZATION;
00200 P1 ← ARCSEG[0];
00300 P2 ← ARCSEG[1] LSH -18;
00400 P3 ← ARCSEG[1] LAND '777777;
00500 X1 ← PXY[P1,1]; Y1 ← PXY[P1,2];
00600 X2 ← PXY[P2,1]; Y2 ← PXY[P2,2];
00700 IF P3=0 THEN
00800 BEGIN
00900 DX ← X2-X1;
01000 DY ← Y2-Y1;
01100 R ← SQRT (DX↑2 + DY↑2);
01200 VX ← DY / R;
01300 VY ← -DX / R;
01400 END ELSE
01500 BEGIN
01600 X3 ← PXY[P3,1]; Y3 ← PXY[P3,2];
01700 X1 ← X1 - X3; Y1 ← Y1 - Y3;
01800 X2 ← X2 - X3; Y2 ← Y2 - Y3;
01900 IF X1*Y2 > X2*Y1 THEN BEGIN X1 ← -X1; Y1 ← -Y1; END;
02000 R ← SQRT (X1↑2 + X2↑2);
02100 VX ← X1 / R;
02200 VY ← Y1 / R;
02300 END;
02400 X ← X1 + VX*DISPLACEXY;
02500 Y ← Y1 + VY*DISPLACEXY;
02600 Z ← PLZ[1,2] + DISPLACEZ;
02700 ARRYOUT(2,X,3);
02800 DPYX ← X;
02900 DPYY ← Y;
03000 IF POG=0 THEN POG←1;
03100 DPYSET (DPYBUF);
03200 AIVECT (1.5*X,1.5*Y);
03300 P2 ← P1;
03400 ARCSEGPTR← POINT(18,ARCSEG[1],-1);
03500 GRADE(PLZ[1,1],PLZ[1,2],PLZ[2,1],PLZ[2,2]);
03600 PLZPTR ← 1;
00100 α MAIN LOOP;
00200 FOR I←1 STEP 1 UNTIL N3 DO
00300 BEGIN "MAIN"
00400 DPYSST(CVS(I)); AIVECT(1.5*DPYX,1.5*DPYY);
00500 P1 ← P2;
00600 P2 ← ILDB (ARCSEGPTR);
00700 P3 ← ILDB (ARCSEGPTR);
00800 IF P3=0 THEN
00900 BEGIN "SEGMENT"
01000 X1 ← PXY[P1,1]; Y1 ← PXY[P1,2];
01100 X2 ← PXY[P2,1]; Y2 ← PXY[P2,2];
01200 DX ← X2 - X1; DY ← Y2 - Y1;
01300 SEGLENGTH ← SQRT (DX↑2 + DY↑2);
01400 N ← SEGLENGTH / DU;
01500 IF N=0 THEN N←1;
01600 DL ← SEGLENGTH / N;
01700 DX ← DX / N;
01800 DY ← DY / N;
01900 FOR J←1 STEP 1 UNTIL N DO
02000 BEGIN
02100 X ← X + DX;
02200 Y ← Y + DY;
02300 U ← U + DL;
02400 ZELEV;
02500 ARRYOUT(2,X,3);
02600 DPYSEG;
02700 END;
02800 N4 ← N4 + N;
02900 END "SEGMENT" ELSE
00100 BEGIN "ARC"
00200 REAL β,Cβ,Sβ,COSINE;
00300 X1 ← PXY[P1,1]; Y1 ← PXY[P1,2];
00400 X2 ← PXY[P2,1]; Y2 ← PXY[P2,2];
00500 X3 ← PXY[P3,1]; Y3 ← PXY[P3,2];
00600 X1 ← X1 - X3; Y1 ← Y1 - Y3;
00700 X2 ← X2 - X3; Y2 ← Y2 - Y3;
00800 R ← SQRT ((X1↑2 + Y1↑2 + X2↑2 + Y2↑2)/2);
00900 COSINE ← (X1*X2 + Y1*Y2) /(SQRT(X1↑2 + Y1↑2)*SQRT(X2↑2 + Y2↑2));
01000 β ← ACOS(COSINE);
01100 ARCLENGTH ← R*β;
01200 N ← ARCLENGTH / DU;
01300 IF N=0 THEN N←1;
01400 DL ← ARCLENGTH / N;
01500 β ← β/N;
01600 Cβ ← COS(β);
01700 Sβ ← SIN(β);
01800 IF X1*Y2 < X2*Y1 THEN Sβ ← -Sβ;
01900 VX ← X-X3;
02000 VY ← Y-Y3;
02100 FOR J←1 STEP 1 UNTIL N DO
02200 BEGIN
02300 REAL VXX;
02400 VXX ← Cβ*VX - Sβ*VY;
02500 VY ← Cβ*VY + Sβ*VX;
02600 VX ← VXX;
02700 X ← X3 + VX;
02800 Y ← Y3 + VY;
02900 U ← U +DL;
03000 ZELEV;
03100 ARRYOUT(2,X,3);
03200 DPYSEG;
03300 END;
03400 N4 ← N4 + N;
03500 END "ARC";
03600
03700 END "MAIN";
03800 AVECT(1.5*X,1.5*Y);
03900 DPYOUT(POG←POG+1);
04000 OUTSTR(9&CVS(N4)&" 3D VECTORS CREATED."&13&10);
04100 OUTSTR(9&CVOS(N4)&" 3D VECTORS CREATED."&13&10);
00100 OUTSTR("CLOSE NOW ?");
00200 IF INCHRW = "N" THEN GO L;
00300 BEGIN
00400 INTEGER ARRAY BLK[1:128];
00500 ARRYOUT(2,BLK[1],128);
00600 USETI(2,1);
00700 ARRYIN(2,BLK[1],128);
00800 BLK[1] ← N4;
00900 USETO(2,1);
01000 ARRYOUT(2,BLK[1],128);
01100 USETO(2,99999);
01200 CLOSE(2);
01300 RELEASE(2);
01400 END;
01500
01600 END "DATA BLK";
01700
01800 END "TRAJCT";